home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / html_tags.tcl.z / html_tags.tcl
Text File  |  2002-07-08  |  6KB  |  209 lines
  1. # tags.tcl --
  2. #    Support for random tags, and some new ones, too.
  3. # Copyright (c) 1995 by Sun Microsystems
  4. #
  5. # See the file "license.terms" for information on usage and redistribution
  6. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  7. #
  8.  
  9. foreach tag {p div h1 h2 h3 h4 h5 h6} {
  10.     proc HMtag_$tag {win param text} {
  11.     set align ""
  12.     HMextract_param $param align
  13.     HMstack $win [list Tcenter $align]
  14.     }
  15.     proc HMtag_/$tag {win param text} {
  16.     catch {HMstack/ $win [list Tcenter {}]}
  17.     }
  18. }
  19.  
  20. # pre is used in all sorts of wierd contexts,
  21. # and adding H:pre to the list tags preserves it across
  22. # whitespace added by some tags (e.g., hr)
  23. proc HMtag_pre {win param text} {
  24.     HMstack $win [list listtags H:pre]
  25. }
  26. proc HMtag_/pre {win param text} {
  27.     catch {HMstack/ $win [list listtags]}
  28. }
  29.  
  30. # Handle base tags.  This affects link references in subsequent
  31. # img SRC= and a HREF= tags.  Note that <base> tags are used in cut & paste
  32. # to preserve (or adjust) relative links when possible (or necessary).
  33.  
  34. proc HMtag_base {win param text} {
  35.     upvar #0 HM$win var
  36.     if [HMextract_param $param href Url] {
  37.     if [info exists var(pasteMode)] {
  38.         set var(base) $Url
  39.         Exmh_Debug "Paste/Base $Url"
  40.         Mark_RemoveLast $win 
  41.     } else {
  42.         set var(S_url) $Url
  43.         Exmh_Debug "Base $Url"
  44.     }
  45.     }
  46. }
  47.  
  48. # downloading fonts can take a long time.  We'll override the default
  49. # font-setting routine to permit better user feedback on fonts.  We'll
  50. # keep our own list of installed fonts on the side, to guess when delays
  51. # are likely
  52.  
  53. proc HMset_font {win tag font} {
  54.     global Fonts
  55.     set label [StatusLabel $win]    ;# This may not exist for msg dialogs
  56.     if {![info exists Fonts($font)]} {
  57.         set Fonts($font) 1
  58.         catch {$label configure -fg blue}
  59.         Status $win "downloading font $font"
  60.         set status 1
  61.     }
  62.     catch {$win tag configure $tag -font $font}
  63.     if [info exists status] {
  64.         StatusLazy $win {}
  65.         catch {$label configure -fg black}
  66.     }
  67. }
  68.  
  69. # Lets invent a new HTML tag, just for fun.
  70. # Change the color of the text. Use html tags of the form:
  71. # <color value=blue> ... </color>
  72. # We can invent a new tag for the display stack.  If it starts with "T"
  73. # it will automatically get mapped directly to a text widget tag.
  74.  
  75. proc HMtag_color {win param text} {
  76.     set value bad_color
  77.     HMextract_param $param value
  78.     HMstack $win "Tcolor $value"
  79.     if [catch {$win tag configure $value -foreground $value}] {
  80.         catch {$win tag configure $value -foreground #$value}
  81.     }
  82. }
  83.  
  84. proc HMtag_/color {win param text} {
  85.     catch {HMstack/ $win "Tcolor {}"}
  86. }
  87.  
  88. # Add a font size manipulation primitive, so we can use this sample program
  89. # for on-line presentations.  sizes prefixed with + or - are relative.
  90. #  <font size=[+-]3>  ..... </font>.
  91. # This is an approximation of the NetScape font tag
  92.  
  93. proc HMtag_font {win param text} {
  94.     upvar #0 HM$win var
  95.     set size 0; set sign ""
  96.     if [HMextract_param $param size] {
  97.     regexp {([+-])? *([0-9]+)} $size dummy sign size
  98.     if {$sign != ""} {
  99.         set base [lindex $var(size) end]
  100.         set size [eval expr $base $sign $size]
  101.     }
  102.     if {$size < 1} {set size 1}
  103.     if {$size > 7} {set size 7}
  104.     HMstack $win "size $size"
  105.     set var(font_size) $size
  106.     }
  107.     set color bad_color
  108.     if [HMextract_param $param color] {
  109.     HMstack $win "Tcolor $color"
  110.     if [catch {$win tag configure $color -foreground $color}] {
  111.         catch {$win tag configure $color -foreground #$color}
  112.     }
  113.     set var(font_color) $color
  114.     }
  115. }
  116.  
  117. proc HMtag_/font {win param text} {
  118.     upvar #0 HM$win var
  119.     if [info exists var(font_size)] {
  120.         catch {HMstack/ $win "size {}"}
  121.         unset var(font_size)
  122.     }
  123.     if [info exists var(font_color)] {
  124.         catch {HMstack/ $win "Tcolor {}"}
  125.         unset var(font_color)
  126.     }
  127. }
  128.  
  129. # Crude hack to make tables somewhat nicer to read until real stuff is in place
  130.  
  131. if {[info commands HMtag_/tr] == ""} {
  132.  
  133.     proc HMtag_/tr {win param textVar} {
  134.         upvar #0 HM$win var
  135.         upvar $textVar text
  136.         MarkUndefined $win /tr $param text
  137.         Text_Insert $win $var(S_insert) \n $var(inserttags)
  138.     }
  139.     proc HMtag_tr {win param textVar} {
  140.         upvar #0 HM$win var
  141.         upvar $textVar text
  142.         MarkUndefined $win tr $param text
  143.     }
  144. }
  145.  
  146. proc HMtag_Verify {t param} {
  147.     global htmlverify
  148.  
  149.     Exmh_Debug HMtag_Verify $t $param
  150.     if [catch {frame $t.verify -bd 4 -relief ridge -class Dialog} f] {
  151.     # dialog already up
  152.     SeditAbortConfirm $t.abort $t abort
  153.     return
  154.     }
  155.     Widget_Message $f msg -justify center -text "Are you sure you want to execute\n\n$param\n\n?"
  156.     pack $f.msg -padx 10 -pady 10
  157.     frame $f.but -bd 10 -relief flat
  158.     pack $f.but -expand true -fill both
  159.     Widget_AddBut $f.but yes "Yes" [list HMtag_VerifyConfirm $f yes] {left filly}
  160.     Widget_AddBut $f.but no "No" [list HMtag_VerifyConfirm $f No] {right filly}
  161.     Widget_PlaceDialog $t $f
  162.     focus $f.but
  163.     tkwait window $f
  164.  
  165.     if {$htmlverify == "yes"} {
  166.     Exmh_Debug Evaluating $param
  167.     eval $param
  168.     }
  169. }
  170.  
  171. proc HMtag_VerifyConfirm {f yes} {
  172.     global htmlverify
  173.     set htmlverify $yes
  174.     destroy $f
  175. }
  176.  
  177. proc HMtag_Wrapped {win param} {
  178.     Exmh_Debug HMtag_Wrapped $win $param
  179.  
  180.     upvar #0 HM$win var
  181.     set url $var(S_url)
  182.     Exmh_Debug URL=$url
  183.     if {![regexp -nocase {^file:} $url] || [regexp -nocase "^file:[Env_Tmp]" $url]} {
  184.     set index [lsearch -exact $param -command]
  185.     if {$index != -1} {
  186.         incr index
  187.         set param [lreplace $param $index $index [list HMtag_Verify $win [lindex $param $index]]]
  188.     }
  189.     }
  190.     Exmh_Debug HMtag_Wrapped returning $param
  191.     return $param
  192. }
  193.  
  194. proc HMtag_button {win param textVar} {
  195.     upvar #0 HM$win var
  196.     upvar $textVar text
  197.     set b [eval {button $win.button$var(tags) -text $text} [HMtag_Wrapped $win $param]]
  198.     Win_Install $win $b
  199.     set text {}
  200. }
  201. proc HMtag_checkbutton {win param textVar} {
  202.     upvar #0 HM$win var
  203.     upvar $textVar text
  204.     set b [eval {checkbutton $win.button$var(tags) -text $text} [HMtag_Wrapped $win $param]]
  205.     Win_Install $win $b
  206.     set text {}
  207. }
  208.  
  209.